home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnus / gnus-gl.el.z / gnus-gl.el
Encoding:
Text File  |  1998-05-21  |  30.3 KB  |  861 lines
  1. ;;; gnus-gl.el --- an interface to GroupLens for Gnus
  2. ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Brad Miller <bmiller@cs.umn.edu>
  5. ;; Keywords: news, score
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.     See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27. ;; GroupLens software and documentation is copyright (c) 1995 by Paul
  28. ;; Resnick (Massachusetts Institute of Technology); Brad Miller, John
  29. ;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota),
  30. ;; and David Maltz (Carnegie-Mellon University).
  31. ;;
  32. ;; Permission to use, copy, modify, and distribute this documentation
  33. ;; for non-commercial and commercial purposes without fee is hereby
  34. ;; granted provided that this copyright notice and permission notice
  35. ;; appears in all copies and that the names of the individuals and
  36. ;; institutions holding this copyright are not used in advertising or
  37. ;; publicity pertaining to this software without specific, written
  38. ;; prior permission.  The copyright holders make no representations
  39. ;; about the suitability of this software and documentation for any
  40. ;; purpose.  It is provided ``as is'' without express or implied
  41. ;; warranty.
  42. ;;
  43. ;; The copyright holders request that they be notified of
  44. ;; modifications of this code.  Please send electronic mail to
  45. ;; grouplens@cs.umn.edu for more information or to announce derived
  46. ;; works.
  47. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48. ;; Author: Brad Miller
  49. ;;
  50. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  51. ;;
  52. ;; User Documentation:
  53. ;; To use GroupLens you must load this file.
  54. ;; You must also register a pseudonym with the Better Bit Bureau.
  55. ;; http://www.cs.umn.edu/Research/GroupLens
  56. ;;
  57. ;;    ---------------- For your .emacs or .gnus file ----------------
  58. ;;
  59. ;; As of version 2.5, grouplens now works as a minor mode of
  60. ;; gnus-summary-mode.  To get make that work you just need a couple of
  61. ;; hooks.
  62. ;; (setq gnus-use-grouplens t)
  63. ;; (setq grouplens-pseudonym "")
  64. ;; (setq grouplens-bbb-host "grouplens.cs.umn.edu")
  65. ;;
  66. ;; (setq gnus-summary-default-score 0)
  67. ;;
  68. ;;                              USING GROUPLENS
  69. ;; How do I Rate an article??
  70. ;;   Before you type n to go to the next article, hit a number from 1-5
  71. ;;   Type r in the summary buffer and you will be prompted.
  72. ;;   Note that when you're in grouplens-minor-mode 'r' masks the
  73. ;;   usual reply binding for 'r'
  74. ;;
  75. ;; What if, Gasp, I find a bug???
  76. ;; Please type M-x gnus-gl-submit-bug-report.  This will set up a
  77. ;; mail buffer with the  state of variables and buffers that will help
  78. ;; me debug the problem.  A short description up front would help too!
  79. ;;
  80. ;; How do I display the prediction for an article:
  81. ;;  If you set the gnus-summary-line-format as shown above, the score
  82. ;;  (prediction) will be shown automatically.
  83. ;;
  84. ;;
  85. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  86. ;; Programmer  Notes
  87. ;; 10/9/95
  88. ;; gnus-scores-articles contains the articles
  89. ;; When scoring is done, the call tree looks something like:
  90. ;; gnus-possibly-score-headers
  91. ;;  ==> gnus-score-headers
  92. ;;      ==> gnus-score-load-file
  93. ;;          ==> get-all-mids  (from the eval form)
  94. ;;
  95. ;; it would be nice to have one that gets called after all the other
  96. ;; headers have been scored.
  97. ;; we may want a variable gnus-grouplens-scale-factor
  98. ;; and gnus-grouplens-offset  this would probably be either -3 or 0
  99. ;; to make the scores centered around zero or not.
  100. ;; Notes 10/12/95
  101. ;; According to Lars, Norse god of gnus, the simple way to insert a
  102. ;; call to an external function is to have a function added to the
  103. ;; variable gnus-score-find-files-function  This new function
  104. ;; gnus-grouplens-score-alist will return a core alist that
  105. ;; has (("message-id" ("<message-id-xxxx>" score) ("<message-id-xxxy>" score))
  106. ;; This seems like it would be pretty inefficient, though workable.
  107. ;;
  108. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  109. ;;  TODO
  110. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  111. ;;
  112. ;; 3. Add some more ways to rate messages
  113. ;; 4. Better error handling for token timeouts.
  114. ;;
  115. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  116. ;; bugs
  117. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  118. ;;
  119.  
  120. ;;; Code:
  121.  
  122. (eval-when-compile (require 'cl))
  123.  
  124. (require 'gnus-score)
  125. (require 'gnus)
  126.  
  127. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  128. ;;;; User variables
  129. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  130.  
  131. (defvar gnus-summary-grouplens-line-format
  132.   "%U\%R\%z%l%I\%(%[%4L: %-20,20n%]%) %s\n"
  133.   "*The line format spec in summary GroupLens mode buffers.")
  134.  
  135. (defvar grouplens-pseudonym ""
  136.   "User's pseudonym.
  137. This pseudonym is obtained during the registration process")
  138.  
  139. (defvar grouplens-bbb-host "grouplens.cs.umn.edu"
  140.   "Host where the bbbd is running" )
  141.  
  142. (defvar grouplens-bbb-port 9000
  143.   "Port where the bbbd is listening" )
  144.  
  145. (defvar grouplens-newsgroups
  146.   '("comp.groupware" "comp.human-factors" "comp.lang.c++"
  147.     "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy"
  148.     "comp.os.linux.announce" "comp.os.linux.answers"
  149.     "comp.os.linux.development" "comp.os.linux.development.apps"
  150.     "comp.os.linux.development.system" "comp.os.linux.hardware"
  151.     "comp.os.linux.help" "comp.os.linux.m68k" "comp.os.linux.misc"
  152.     "comp.os.linux.networking" "comp.os.linux.setup" "comp.os.linux.x"
  153.     "mn.general" "rec.arts.movies" "rec.arts.movies.current-films"
  154.     "rec.food.recipes" "rec.humor")
  155.   "*Groups that are part of the GroupLens experiment.")
  156.  
  157. (defvar grouplens-prediction-display 'prediction-spot
  158.   "valid values are:
  159.       prediction-spot -- an * corresponding to the prediction between 1 and 5,
  160.       confidence-interval -- a numeric confidence interval
  161.       prediction-bar --  |#####     | the longer the bar, the better the article,
  162.       confidence-bar --  |  -----   } the prediction is in the middle of the bar,
  163.       confidence-spot -- )  *       | the spot gets bigger with more confidence,
  164.       prediction-num  --   plain-old numeric value,
  165.       confidence-plus-minus  -- prediction +/i confidence")
  166.  
  167. (defvar grouplens-score-offset 0
  168.   "Offset the prediction by this value.
  169. Setting this variable to -2 would have the following effect on
  170. GroupLens scores:
  171.  
  172.    1   -->   -2
  173.    2   -->   -1
  174.    3   -->    0
  175.    4   -->    1
  176.    5   -->    2
  177.  
  178. The reason is that a user might want to do this is to combine
  179. GroupLens predictions with scores calculated by other score methods.")
  180.  
  181. (defvar grouplens-score-scale-factor 1
  182.   "This variable allows the user to magnify the effect of GroupLens scores.
  183. The scale factor is applied after the offset.")
  184.  
  185. (defvar gnus-grouplens-override-scoring 'override
  186.   "Tell GroupLens to override the normal Gnus scoring mechanism.
  187. GroupLens scores can be combined with gnus scores in one of three ways.
  188. 'override -- just use grouplens predictions for grouplens groups
  189. 'combine  -- combine grouplens scores with gnus scores
  190. 'separate -- treat grouplens scores completely separate from gnus")
  191.  
  192.  
  193. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  194. ;;;; Program global variables
  195. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  196. (defvar grouplens-bbb-token nil
  197.   "Current session token number")
  198.  
  199. (defvar grouplens-bbb-process nil
  200.   "Process Id of current bbbd network stream process")
  201.  
  202. (defvar grouplens-bbb-buffer nil
  203.   "Buffer associated with the BBBD process")
  204.  
  205. (defvar grouplens-rating-alist nil
  206.   "Current set of  message-id rating pairs")
  207.  
  208. (defvar grouplens-current-hashtable nil
  209.   "A hashtable to hold predictions from the BBB")
  210.  
  211. (defvar grouplens-current-group nil)
  212.  
  213. ;;(defvar bbb-alist nil)
  214.  
  215. (defvar bbb-timeout-secs 10
  216.   "Number of seconds to wait for some response from the BBB.
  217. If this times out we give up and assume that something has died..." )
  218.  
  219. (defvar grouplens-previous-article nil
  220.   "Message-ID of the last article read.")
  221.  
  222. (defvar bbb-read-point)
  223. (defvar bbb-response-point)
  224.  
  225. (defun bbb-renew-hash-table ()
  226.   (setq grouplens-current-hashtable (make-vector 100 0)))
  227.  
  228. (bbb-renew-hash-table)
  229.  
  230. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  231. ;;;;  Utility Functions
  232. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  233.  
  234. (defun bbb-connect-to-bbbd (host port)
  235.   (unless grouplens-bbb-buffer
  236.     (setq grouplens-bbb-buffer
  237.       (get-buffer-create (format " *BBBD trace: %s*" host)))
  238.     (save-excursion
  239.       (set-buffer grouplens-bbb-buffer)
  240.       (make-local-variable 'bbb-read-point)
  241.       (make-local-variable 'bbb-response-point)
  242.       (setq bbb-read-point (point-min))))
  243.  
  244.   ;; if an old process is still running for some reason, kill it
  245.   (when grouplens-bbb-process
  246.     (ignore-errors
  247.       (when (eq 'open (process-status grouplens-bbb-process))
  248.     (set-process-buffer grouplens-bbb-process nil)
  249.     (delete-process grouplens-bbb-process))))
  250.  
  251.   ;; clear the trace buffer of old output
  252.   (save-excursion
  253.     (set-buffer grouplens-bbb-buffer)
  254.     (erase-buffer))
  255.  
  256.   ;; open the connection to the server
  257.   (catch 'done
  258.     (condition-case error
  259.     (setq grouplens-bbb-process
  260.           (open-network-stream "BBBD" grouplens-bbb-buffer host port))
  261.       (error (gnus-message 3 "Error: Failed to connect to BBB")
  262.          nil))
  263.     (and (null grouplens-bbb-process)
  264.      (throw 'done nil))
  265.     (save-excursion
  266.       (set-buffer grouplens-bbb-buffer)
  267.       (setq bbb-read-point (point-min))
  268.       (or (bbb-read-response grouplens-bbb-process)
  269.       (throw 'done nil))))
  270.  
  271.   ;; return the process
  272.   grouplens-bbb-process)
  273.  
  274. (defun bbb-send-command (process command)
  275.   (goto-char (point-max))
  276.   (insert command)
  277.   (insert "\r\n")
  278.   (setq bbb-read-point (point))
  279.   (setq bbb-response-point (point))
  280.   (set-marker (process-mark process) (point)) ; process output also comes here
  281.   (process-send-string process command)
  282.   (process-send-string process "\r\n")
  283.   (process-send-eof process))
  284.  
  285. (defun bbb-read-response (process)
  286.   "This function eats the initial response of OK or ERROR from the BBB."
  287.   (let ((case-fold-search nil)
  288.     match-end)
  289.     (goto-char bbb-read-point)
  290.     (while (and (not (search-forward "\r\n" nil t))
  291.         (accept-process-output process bbb-timeout-secs))
  292.       (goto-char bbb-read-point))
  293.     (setq match-end (point))
  294.     (goto-char bbb-read-point)
  295.     (setq bbb-read-point match-end)
  296.     (looking-at "OK")))
  297.  
  298. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  299. ;;;;       Login Functions
  300. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  301. (defun bbb-login ()
  302.   "return the token number if login is successful, otherwise return nil"
  303.   (interactive)
  304.   (setq grouplens-bbb-token nil)
  305.   (if (not (equal grouplens-pseudonym ""))
  306.       (let ((bbb-process
  307.          (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
  308.     (if bbb-process
  309.         (save-excursion
  310.           (set-buffer (process-buffer bbb-process))
  311.           (bbb-send-command bbb-process
  312.                 (concat "login " grouplens-pseudonym))
  313.           (if (bbb-read-response bbb-process)
  314.           (setq grouplens-bbb-token (bbb-extract-token-number))
  315.           (gnus-message 3 "Error: GroupLens login failed")))))
  316.     (gnus-message 3 "Error: you must set a pseudonym"))
  317.   grouplens-bbb-token)
  318.  
  319. (defun bbb-extract-token-number ()
  320.   (let ((token-pos (search-forward "token=" nil t)))
  321.     (when (looking-at "[0-9]+")
  322.       (buffer-substring token-pos (match-end 0)))))
  323.  
  324. (gnus-add-shutdown 'bbb-logout 'gnus)
  325.  
  326. (defun bbb-logout ()
  327.   "logout of bbb session"
  328.   (when grouplens-bbb-token
  329.     (let ((bbb-process
  330.        (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
  331.       (when bbb-process
  332.     (save-excursion
  333.       (set-buffer (process-buffer bbb-process))
  334.       (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token))
  335.       (bbb-read-response bbb-process))))))
  336.  
  337. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  338. ;;;;       Get Predictions
  339. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  340.  
  341. (defun bbb-build-mid-scores-alist (groupname)
  342.   "this function can be called as part of the function to return the
  343. list of score files to use.  See the gnus variable
  344. gnus-score-find-score-files-function.
  345.  
  346. *Note:*  If you want to use grouplens scores along with calculated scores,
  347. you should see the offset and scale variables.  At this point, I don't
  348. recommend using both scores and grouplens predictions together."
  349.   (setq grouplens-current-group groupname)
  350.   (when (member groupname grouplens-newsgroups)
  351.     (setq grouplens-previous-article nil)
  352.     ;; scores-alist should be a list of lists:
  353.     ;;  ((("message-id" ("<mid1>" score1 nil s) ("<mid2> score2 nil s))))
  354.     ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value
  355.     (list
  356.      (list
  357.       (list (append (list "message-id")
  358.             (bbb-get-predictions (bbb-get-all-mids) groupname)))))))
  359.  
  360. (defun bbb-get-predictions (midlist groupname)
  361.   "Ask the bbb for predictions, and build up the score alist."
  362.   (gnus-message 5 "Fetching Predictions...")
  363.   (if grouplens-bbb-token
  364.       (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host
  365.                           grouplens-bbb-port)))
  366.     (when bbb-process
  367.       (save-excursion
  368.         (set-buffer (process-buffer bbb-process))
  369.         (bbb-send-command bbb-process
  370.                   (bbb-build-predict-command midlist groupname
  371.                              grouplens-bbb-token))
  372.         (if (bbb-read-response bbb-process)
  373.         (bbb-get-prediction-response bbb-process)
  374.           (gnus-message 1 "Invalid Token, login and try again")
  375.           (ding)))))
  376.     (gnus-message 3 "Error: You are not logged in to a BBB")
  377.     (ding)))
  378.  
  379. (defun bbb-get-all-mids ()
  380.   (mapcar (function (lambda (x) (mail-header-id x))) gnus-newsgroup-headers))
  381.  
  382. (defun bbb-build-predict-command (mlist grpname token)
  383.   (concat "getpredictions " token " " grpname "\r\n"
  384.       (mapconcat 'identity mlist "\r\n") "\r\n.\r\n"))
  385.  
  386. (defun bbb-get-prediction-response (process)
  387.   (let ((case-fold-search nil))
  388.     (goto-char bbb-read-point)
  389.     (while (and (not (search-forward ".\r\n" nil t))
  390.         (accept-process-output process bbb-timeout-secs))
  391.       (goto-char bbb-read-point))
  392.     (goto-char (+ bbb-response-point 4));; we ought to be right before OK
  393.     (bbb-build-response-alist)))
  394.  
  395. ;; build-response-alist assumes that the cursor has been positioned at
  396. ;; the first line of the list of mid/rating pairs.
  397. (defun bbb-build-response-alist ()
  398.   (let (resp mid pred)
  399.     (while
  400.     (cond
  401.      ((looking-at "\\(<.*>\\) :nopred=")
  402.       ;;(push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp)
  403.       (forward-line 1)
  404.       t)
  405.      ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)")
  406.       (setq mid (bbb-get-mid)
  407.         pred (bbb-get-pred))
  408.       (push `(,mid ,pred nil s) resp)
  409.       (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh))
  410.               grouplens-current-hashtable)
  411.       (forward-line 1)
  412.       t)
  413.      ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)")
  414.       (setq mid (bbb-get-mid)
  415.         pred (bbb-get-pred))
  416.       (push `(,mid ,pred nil s) resp)
  417.       (gnus-sethash mid (list pred 0 0) grouplens-current-hashtable)
  418.       (forward-line 1)
  419.       t)
  420.      (t nil)))
  421.     resp))
  422.  
  423. ;; these "get" functions assume that there is an active match lying
  424. ;; around.  Where the first parenthesized expression is the
  425. ;; message-id, and the second is the prediction, the third and fourth
  426. ;; are the confidence interval
  427. ;;
  428. ;; Since gnus assumes that scores are integer values?? we round the
  429. ;; prediction.
  430. (defun bbb-get-mid ()
  431.   (buffer-substring (match-beginning 1) (match-end 1)))
  432.  
  433. (defun bbb-get-pred ()
  434.   (let ((tpred (string-to-number (buffer-substring (match-beginning 2)
  435.                            (match-end 2)))))
  436.     (if (> tpred 0)
  437.     (round (* grouplens-score-scale-factor
  438.           (+ grouplens-score-offset tpred)))
  439.       1)))
  440.  
  441. (defun bbb-get-confl ()
  442.   (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
  443.  
  444. (defun bbb-get-confh ()
  445.   (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
  446.  
  447. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  448. ;;;;      Prediction Display
  449. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  450. (defconst grplens-rating-range 4.0)
  451. (defconst grplens-maxrating 5)
  452. (defconst grplens-minrating 1)
  453. (defconst grplens-predstringsize 12)
  454.  
  455. (defvar gnus-tmp-score)
  456. (defun bbb-grouplens-score (header)
  457.   (if (eq gnus-grouplens-override-scoring 'separate)
  458.       (bbb-grouplens-other-score header)
  459.     (let* ((rate-string (make-string 12 ?\ ))
  460.        (mid (mail-header-id header))
  461.        (hashent (gnus-gethash mid grouplens-current-hashtable))
  462.        (iscore gnus-tmp-score)
  463.        (low (car (cdr hashent)))
  464.        (high (car (cdr (cdr hashent)))))
  465.       (aset rate-string 0 ?|)
  466.       (aset rate-string 11 ?|)
  467.       (unless (member grouplens-current-group grouplens-newsgroups)
  468.     (unless (equal grouplens-prediction-display 'prediction-num)
  469.       (cond ((< iscore 0)
  470.          (setq iscore 1))
  471.         ((> iscore 5)
  472.          (setq iscore 5))))
  473.     (setq low 0)
  474.     (setq high 0))
  475.       (if (and (bbb-valid-score iscore)
  476.            (not (null mid)))
  477.       (cond
  478.        ;; prediction-spot
  479.        ((equal grouplens-prediction-display 'prediction-spot)
  480.         (setq rate-string (bbb-fmt-prediction-spot rate-string iscore)))
  481.        ;; confidence-interval
  482.        ((equal grouplens-prediction-display 'confidence-interval)
  483.         (setq rate-string (bbb-fmt-confidence-interval iscore low high)))
  484.        ;; prediction-bar
  485.        ((equal grouplens-prediction-display 'prediction-bar)
  486.         (setq rate-string (bbb-fmt-prediction-bar rate-string iscore)))
  487.        ;; confidence-bar
  488.        ((equal grouplens-prediction-display 'confidence-bar)
  489.         (setq rate-string (format "|   %4.2f   |" iscore)))
  490.        ;; confidence-spot
  491.        ((equal grouplens-prediction-display 'confidence-spot)
  492.         (setq rate-string (format "|   %4.2f   |" iscore)))
  493.        ;; prediction-num
  494.        ((equal grouplens-prediction-display 'prediction-num)
  495.         (setq rate-string (bbb-fmt-prediction-num iscore)))
  496.        ;; confidence-plus-minus
  497.        ((equal grouplens-prediction-display 'confidence-plus-minus)
  498.         (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high))
  499.         )
  500.        (t (gnus-message 3 "Invalid prediction display type")))
  501.     (aset rate-string 5 ?N) (aset rate-string 6 ?A))
  502.       rate-string)))
  503.  
  504. ;; Gnus user format function that doesn't depend on
  505. ;; bbb-build-mid-scores-alist being used as the score function, but is
  506. ;; instead called from gnus-select-group-hook. -- LAB
  507. (defun bbb-grouplens-other-score (header)
  508.   (if (not (member grouplens-current-group grouplens-newsgroups))
  509.       ;; Return an empty string
  510.       ""
  511.     (let* ((rate-string (make-string 12 ?\ ))
  512.            (mid (mail-header-id header))
  513.            (hashent (gnus-gethash mid grouplens-current-hashtable))
  514.            (pred (or (nth 0 hashent) 0))
  515.            (low (nth 1 hashent))
  516.            (high (nth 2 hashent)))
  517.       ;; Init rate-string
  518.       (aset rate-string 0 ?|)
  519.       (aset rate-string 11 ?|)
  520.       (unless (equal grouplens-prediction-display 'prediction-num)
  521.     (cond ((< pred 0)
  522.            (setq pred 1))
  523.           ((> pred 5)
  524.            (setq pred 5))))
  525.       ;; If no entry in BBB hash mark rate string as NA and return
  526.       (cond
  527.        ((null hashent)
  528.     (aset rate-string 5 ?N)
  529.     (aset rate-string 6 ?A)
  530.     rate-string)
  531.  
  532.        ((equal grouplens-prediction-display 'prediction-spot)
  533.     (bbb-fmt-prediction-spot rate-string pred))
  534.  
  535.        ((equal grouplens-prediction-display 'confidence-interval)
  536.     (bbb-fmt-confidence-interval pred low high))
  537.  
  538.        ((equal grouplens-prediction-display 'prediction-bar)
  539.     (bbb-fmt-prediction-bar rate-string pred))
  540.  
  541.        ((equal grouplens-prediction-display 'confidence-bar)
  542.     (format "|   %4.2f   |" pred))
  543.  
  544.        ((equal grouplens-prediction-display 'confidence-spot)
  545.     (format "|   %4.2f   |" pred))
  546.  
  547.        ((equal grouplens-prediction-display 'prediction-num)
  548.     (bbb-fmt-prediction-num pred))
  549.  
  550.        ((equal grouplens-prediction-display 'confidence-plus-minus)
  551.     (bbb-fmt-confidence-plus-minus pred low high))
  552.  
  553.        (t
  554.     (gnus-message 3 "Invalid prediction display type")
  555.     (aset rate-string 0 ?|)
  556.     (aset rate-string 11 ?|)
  557.     rate-string)))))
  558.  
  559. (defun bbb-valid-score (score)
  560.   (or (equal grouplens-prediction-display 'prediction-num)
  561.       (and (>= score grplens-minrating)
  562.        (<= score grplens-maxrating))))
  563.  
  564. (defun bbb-requires-confidence (format-type)
  565.   (or (equal format-type 'confidence-plus-minus)
  566.       (equal format-type 'confidence-spot)
  567.       (equal format-type 'confidence-interval)))
  568.  
  569. (defun bbb-have-confidence (clow chigh)
  570.   (not (or (null clow)
  571.        (null chigh))))
  572.  
  573. (defun bbb-fmt-prediction-spot (rate-string score)
  574.   (aset rate-string
  575.     (round (* (/ (- score grplens-minrating) grplens-rating-range)
  576.           (+ (- grplens-predstringsize 4) 1.49)))
  577.     ?*)
  578.   rate-string)
  579.  
  580. (defun bbb-fmt-confidence-interval (score low high)
  581.   (if (bbb-have-confidence low high)
  582.       (format "|%4.2f-%4.2f |" low high)
  583.     (bbb-fmt-prediction-num score)))
  584.  
  585. (defun bbb-fmt-confidence-plus-minus (score low high)
  586.   (if (bbb-have-confidence low high)
  587.       (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0))
  588.     (bbb-fmt-prediction-num score)))
  589.  
  590. (defun bbb-fmt-prediction-bar (rate-string score)
  591.   (let* ((i 1)
  592.      (step (/ grplens-rating-range (- grplens-predstringsize 4)))
  593.      (half-step (/ step 2))
  594.      (loc (- grplens-minrating half-step)))
  595.     (while (< i (- grplens-predstringsize 2))
  596.       (if (> score loc)
  597.       (aset rate-string i ?#)
  598.     (aset rate-string i ?\ ))
  599.       (setq i (+ i 1))
  600.       (setq loc (+ loc step)))
  601.     )
  602.   rate-string)
  603.  
  604. (defun bbb-fmt-prediction-num (score)
  605.   (format "|   %4.2f   |" score))
  606.  
  607. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  608. ;;;;       Put Ratings
  609. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  610.  
  611. (defun bbb-put-ratings ()
  612.   (if (and grouplens-bbb-token
  613.        grouplens-rating-alist
  614.        (member gnus-newsgroup-name grouplens-newsgroups))
  615.       (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host
  616.                           grouplens-bbb-port))
  617.         (rate-command (bbb-build-rate-command grouplens-rating-alist)))
  618.     (if bbb-process
  619.         (save-excursion
  620.           (set-buffer (process-buffer bbb-process))
  621.           (gnus-message 5 "Sending Ratings...")
  622.           (bbb-send-command bbb-process rate-command)
  623.           (if (bbb-read-response bbb-process)
  624.           (setq grouplens-rating-alist nil)
  625.         (gnus-message 1
  626.                   "Token timed out: call bbb-login and quit again")
  627.         (ding))
  628.           (gnus-message 5 "Sending Ratings...Done"))
  629.       (gnus-message 3 "No BBB connection")))
  630.     (setq grouplens-rating-alist nil)))
  631.  
  632. (defun bbb-build-rate-command (rate-alist)
  633.   (concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n"
  634.       (mapconcat '(lambda (this)    ; form (mid . (score . time))
  635.             (concat (car this)
  636.                 " :rating=" (cadr this) ".00"
  637.                 " :time=" (cddr this)))
  638.              rate-alist "\r\n")
  639.       "\r\n.\r\n"))
  640.  
  641. ;; Interactive rating functions.
  642. (defun bbb-summary-rate-article (rating &optional midin)
  643.   (interactive "nRating: ")
  644.   (when (member gnus-newsgroup-name grouplens-newsgroups)
  645.     (let ((mid (or midin (bbb-get-current-id))))
  646.       (if (and rating
  647.            (>= rating grplens-minrating)
  648.            (<= rating grplens-maxrating)
  649.            mid)
  650.       (let ((oldrating (assoc mid grouplens-rating-alist)))
  651.         (if oldrating
  652.         (setcdr oldrating (cons rating 0))
  653.           (push `(,mid . (,rating . 0)) grouplens-rating-alist))
  654.         (gnus-summary-mark-article nil (int-to-string rating)))
  655.     (gnus-message 3 "Invalid rating")))))
  656.  
  657. (defun grouplens-next-unread-article (rating)
  658.   "Select unread article after current one."
  659.   (interactive "P")
  660.   (when rating
  661.     (bbb-summary-rate-article rating))
  662.   (gnus-summary-next-unread-article))
  663.  
  664. (defun grouplens-best-unread-article (rating)
  665.   "Select unread article after current one."
  666.   (interactive "P")
  667.   (when rating
  668.     (bbb-summary-rate-article rating))
  669.   (gnus-summary-best-unread-article))
  670.  
  671. (defun grouplens-summary-catchup-and-exit (rating)
  672.   "Mark all articles not marked as unread in this newsgroup as read,
  673.     then exit.   If prefix argument ALL is non-nil, all articles are
  674.     marked as read."
  675.   (interactive "P")
  676.   (when rating
  677.     (bbb-summary-rate-article rating))
  678.   (if (numberp rating)
  679.       (gnus-summary-catchup-and-exit)
  680.     (gnus-summary-catchup-and-exit rating)))
  681.  
  682. (defun grouplens-score-thread (score)
  683.   "Raise the score of the articles in the current thread with SCORE."
  684.   (interactive "nRating: ")
  685.   (let (e)
  686.     (save-excursion
  687.       (let ((articles (gnus-summary-articles-in-thread))
  688.         article)
  689.     (while (setq article (pop articles))
  690.       (gnus-summary-goto-subject article)
  691.       (gnus-set-global-variables)
  692.       (bbb-summary-rate-article score
  693.                     (mail-header-id
  694.                      (gnus-summary-article-header article)))))
  695.       (setq e (point)))
  696.     (let ((gnus-summary-check-current t))
  697.       (or (zerop (gnus-summary-next-subject 1 t))
  698.       (goto-char e))))
  699.   (gnus-summary-recenter)
  700.   (gnus-summary-position-point)
  701.   (gnus-set-mode-line 'summary))
  702.  
  703. (defun bbb-exit-group ()
  704.   (bbb-put-ratings)
  705.   (bbb-renew-hash-table))
  706.  
  707. (defun bbb-get-current-id ()
  708.   (if gnus-current-headers
  709.       (mail-header-id gnus-current-headers)
  710.     (gnus-message 3 "You must select an article before you rate it")))
  711.  
  712. (defun bbb-grouplens-group-p (group)
  713.   "Say whether GROUP is a GroupLens group."
  714.   (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" ""))
  715.  
  716. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  717. ;;          TIME SPENT READING
  718. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  719. (defvar grouplens-current-starting-time nil)
  720.  
  721. (defun grouplens-start-timer ()
  722.   (setq grouplens-current-starting-time (current-time)))
  723.  
  724. (defun grouplens-elapsed-time ()
  725.   (let ((et (bbb-time-float (current-time))))
  726.     (- et (bbb-time-float grouplens-current-starting-time))))
  727.  
  728. (defun bbb-time-float (timeval)
  729.   (+ (* (car timeval) 65536)
  730.      (cadr timeval)))
  731.  
  732. (defun grouplens-do-time ()
  733.   (when (member gnus-newsgroup-name grouplens-newsgroups)
  734.     (when grouplens-previous-article
  735.       (let ((elapsed-time (grouplens-elapsed-time))
  736.         (oldrating (assoc grouplens-previous-article
  737.                   grouplens-rating-alist)))
  738.     (if (not oldrating)
  739.         (push `(,grouplens-previous-article . (0 . ,elapsed-time))
  740.           grouplens-rating-alist)
  741.       (setcdr oldrating (cons (cadr oldrating) elapsed-time)))))
  742.     (grouplens-start-timer)
  743.     (setq grouplens-previous-article (bbb-get-current-id))))
  744.  
  745. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  746. ;;          BUG REPORTING
  747. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  748.  
  749. (defconst gnus-gl-version "gnus-gl.el 2.50")
  750. (defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu")
  751. (defun gnus-gl-submit-bug-report ()
  752.   "Submit via mail a bug report on gnus-gl"
  753.   (interactive)
  754.   (require 'reporter)
  755.   (reporter-submit-bug-report gnus-gl-maintainer-address
  756.                   (concat "gnus-gl.el " gnus-gl-version)
  757.                   (list 'grouplens-pseudonym
  758.                     'grouplens-bbb-host
  759.                     'grouplens-bbb-port
  760.                     'grouplens-newsgroups
  761.                     'grouplens-bbb-token
  762.                     'grouplens-bbb-process
  763.                     'grouplens-current-group
  764.                     'grouplens-previous-article)
  765.                   nil
  766.                   'gnus-gl-get-trace))
  767.  
  768. (defun gnus-gl-get-trace ()
  769.   "Insert the contents of the BBBD trace buffer"
  770.   (when grouplens-bbb-buffer
  771.     (insert-buffer grouplens-bbb-buffer)))
  772.  
  773. ;;
  774. ;; GroupLens minor mode
  775. ;;
  776.  
  777. (defvar gnus-grouplens-mode nil
  778.   "Minor mode for providing a GroupLens interface in Gnus summary buffers.")
  779.  
  780. (defvar gnus-grouplens-mode-map nil)
  781.  
  782. (unless gnus-grouplens-mode-map
  783.   (setq gnus-grouplens-mode-map (make-keymap))
  784.   (gnus-define-keys
  785.    gnus-grouplens-mode-map
  786.    "n" grouplens-next-unread-article
  787.    "r" bbb-summary-rate-article
  788.    "k" grouplens-score-thread
  789.    "c" grouplens-summary-catchup-and-exit
  790.    "," grouplens-best-unread-article))
  791.  
  792. (defun gnus-grouplens-make-menu-bar ()
  793.   (unless (boundp 'gnus-grouplens-menu)
  794.     (easy-menu-define
  795.      gnus-grouplens-menu gnus-grouplens-mode-map ""
  796.      '("GroupLens"
  797.        ["Login" bbb-login t]
  798.        ["Rate" bbb-summary-rate-article t]
  799.        ["Next article" grouplens-next-unread-article t]
  800.        ["Best article" grouplens-best-unread-article t]
  801.        ["Raise thread" grouplens-score-thread t]
  802.        ["Report bugs" gnus-gl-submit-bug-report t]))))
  803.  
  804. (defun gnus-grouplens-mode (&optional arg)
  805.   "Minor mode for providing a GroupLens interface in Gnus summary buffers."
  806.   (interactive "P")
  807.   (when (and (eq major-mode 'gnus-summary-mode)
  808.          (member gnus-newsgroup-name grouplens-newsgroups))
  809.     (make-local-variable 'gnus-grouplens-mode)
  810.     (setq gnus-grouplens-mode
  811.       (if (null arg) (not gnus-grouplens-mode)
  812.         (> (prefix-numeric-value arg) 0)))
  813.     (when gnus-grouplens-mode
  814.       (make-local-hook 'gnus-select-article-hook)
  815.       (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local)
  816.       (make-local-hook 'gnus-exit-group-hook)
  817.       (add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local)
  818.       (make-local-variable 'gnus-score-find-score-files-function)
  819.  
  820.       (cond
  821.        ((eq gnus-grouplens-override-scoring 'combine)
  822.     ;; either add bbb-buld-mid-scores-alist to a list
  823.     ;; or make a list
  824.     (if (listp gnus-score-find-score-files-function)
  825.         (setq gnus-score-find-score-files-function
  826.           (append 'bbb-build-mid-scores-alist
  827.               gnus-score-find-score-files-function))
  828.       (setq gnus-score-find-score-files-function
  829.         (list gnus-score-find-score-files-function
  830.               'bbb-build-mid-scores-alist))))
  831.        ;; leave the gnus-score-find-score-files variable alone
  832.        ((eq gnus-grouplens-override-scoring 'separate)
  833.     (add-hook 'gnus-select-group-hook
  834.           (lambda ()
  835.             (bbb-get-predictions (bbb-get-all-mids)
  836.                      gnus-newsgroup-name))))
  837.        ;; default is to override
  838.        (t
  839.     (setq gnus-score-find-score-files-function
  840.           'bbb-build-mid-scores-alist)))
  841.  
  842.       ;; Change how summary lines look
  843.       (make-local-variable 'gnus-summary-line-format)
  844.       (make-local-variable 'gnus-summary-line-format-spec)
  845.       (setq gnus-summary-line-format gnus-summary-grouplens-line-format)
  846.       (setq gnus-summary-line-format-spec nil)
  847.       (gnus-update-format-specifications nil 'summary)
  848.       (gnus-update-summary-mark-positions)
  849.  
  850.       ;; Set up the menu.
  851.       (when (and menu-bar-mode
  852.          (gnus-visual-p 'grouplens-menu 'menu))
  853.     (gnus-grouplens-make-menu-bar))
  854.       (gnus-add-minor-mode
  855.        'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map)
  856.       (run-hooks 'gnus-grouplens-mode-hook))))
  857.  
  858. (provide 'gnus-gl)
  859.  
  860. ;;; gnus-gl.el ends here
  861.